home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue40 / System / UCombo.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-11-02  |  3.9 KB  |  144 lines
  1. unit UCombo;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, FileCtrl;
  8.  
  9. type
  10.     TForm1 = class(TForm)
  11.         ComboBox1: TComboBox;
  12.     Label1: TLabel;
  13.         procedure FormCreate(Sender: TObject);
  14.     procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  15.       Rect: TRect; State: TOwnerDrawState);
  16.     private
  17.         { Private declarations }
  18.         SysImageList: DWord;
  19.         SIL_cx, SIL_cy: Integer;
  20.         procedure AddDrive (DriveName: PChar);
  21.     public
  22.         { Public declarations }
  23.     end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. uses ShellAPI, CommCtrl;
  31.  
  32. {$R *.DFM}
  33.  
  34. function Max (a, b: Integer): Integer;
  35. begin
  36.     if a >= b then Result := a else Result := b;
  37. end;
  38.  
  39. function GetItemHeight (Font: TFont): Integer;
  40. var
  41.     dc: hDC;
  42.     SaveFont: HFont;
  43.     tm: TTextMetric;
  44. begin
  45.     dc := GetDC (0);
  46.     SaveFont := SelectObject (dc, Font.Handle);
  47.     GetTextMetrics (dc, tm);
  48.     Result := tm.tmHeight;
  49.     SelectObject (dc, SaveFont);
  50.     ReleaseDC (0, dc);
  51. end;
  52.  
  53. function VolumeID (Path: PChar): String;
  54. var
  55.     Junk: DWord;
  56.     OldErrorMode: Integer;
  57.     Buf: array [0..Max_Path] of Char;
  58. begin
  59.     Result := '';
  60.     OldErrorMode := SetErrorMode (sem_FailCriticalErrors);
  61.     try
  62.         if GetVolumeInformation (Path, Buf, sizeof (Buf), Nil, Junk, Junk, Nil, 0) then
  63.             if Buf [0] <> #0 then Result := Result + '  ' + StrPas (Buf);
  64.     finally
  65.         SetErrorMode (OldErrorMode);
  66.     end;
  67. end;
  68.  
  69. function NetworkID (Path: PChar): String;
  70. var
  71.     BufferSize: DWord;
  72.     Buf: Array [0..Max_Path] of Char;
  73. begin
  74.     BufferSize := sizeof (Buf);
  75.     if WNetGetConnection (Path, Buf, BufferSize) = 0 then Result := StrPas (Buf)
  76.     else Result := VolumeID (Path);
  77. end;
  78.  
  79. procedure TForm1.FormCreate(Sender: TObject);
  80. var
  81.     p: PChar;
  82.     sfi: TSHFileInfo;
  83.     szDriveList: array [0..255] of Char;
  84. begin
  85.     // Get a handle to the system image list
  86.     SysImageList := SHGetFileInfo ('', 0, sfi, sizeof (sfi),
  87.                     shgfi_SysIconIndex or shgfi_SmallIcon);
  88.  
  89.     // Calculate itemHeight of the combo box
  90.     ImageList_GetIconSize (SysImageList, SIL_cx, SIL_cy);
  91.     ComboBox1.ItemHeight := Max (SIL_cy, GetItemHeight (ComboBox1.Font)) +
  92.                                  (2 * GetSystemMetrics (sm_cyBorder));
  93.     ComboBox1.Style := csOwnerDrawFixed;
  94.  
  95.     // Fill combo box with drive letters
  96.     p := szDriveList;
  97.     GetLogicalDriveStrings (sizeof (szDriveList), szDriveList);
  98.     while p^ <> #0 do begin
  99.         AddDrive (p);
  100.         Inc (p, 4);
  101.     end;
  102.  
  103.     ComboBox1.ItemIndex := 0;
  104. end;
  105.  
  106. procedure TForm1.AddDrive (DriveName: PChar);
  107. var
  108.     S: String;
  109. begin
  110.     S := Copy (UpperCase (StrPas (DriveName)), 1, 2);
  111.  
  112.     case GetDriveType (DriveName) of
  113.         drive_Fixed,
  114.         drive_CDROM,
  115.         drive_RAMDisk:    S := S + VolumeID (DriveName);
  116.         drive_Remote:     S := S + NetworkID (DriveName);
  117.     end;
  118.  
  119.     ComboBox1.Items.Add (S);
  120. end;
  121.  
  122. procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  123. var
  124.     X, Y: Integer;
  125.     shfi: TSHFileInfo;
  126.     szBuff: array [0..255] of Char;
  127. begin
  128.     with Control as TComboBox, Canvas do begin
  129.         FillRect (Rect);
  130.         // Figure out the image list index for this drive
  131.         SHGetFileInfo (StrPCopy (szBuff, Copy (Items [Index], 1, 2) + '\'),
  132.                       0, shfi, sizeof (shfi), shgfi_Icon or shgfi_SmallIcon);
  133.         X := Rect.Left + 2 * GetSystemMetrics (sm_cxBorder);
  134.         Y := Rect.Top + ((Rect.Bottom - Rect.Top - SIL_cy) div 2);
  135.         ImageList_DrawEx (SysImageList, shfi.iIcon, Handle, X, Y, 0, 0,
  136.                           clr_None, clr_None, ild_Transparent);
  137.         Inc (Rect.Left, (SIL_cx * 3) div 2);
  138.         DrawText (Handle, PChar (Items [Index]), -1, Rect, dt_Left or dt_VCenter);
  139.     end;
  140. end;
  141.  
  142. end.
  143.  
  144.